home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.05 May 87 / Paint Files source / LSP source / PaintFileMgr.text next >
Encoding:
Text File  |  1987-04-10  |  6.3 KB  |  218 lines  |  [TEXT/PJMM]
  1. {________________________________________________}
  2. {PAINTFILEMGR  Unit                                                                  }
  3. {                                                                                                }
  4. {    Procedures for opening and displaying Paint files with           }
  5. {    high level routines from Toolbox file manager.  This might     }
  6. {    not work in a 128K Mac, but could probably be made to work }
  7. {    by reading and unpacking the file in smaller chunks.                }
  8. {                                                                                                 }
  9. {AUTHOR                                                                                     }
  10. {    Gary B. Palmer.  Public domain. October 25, 1986.                 }
  11. {    Author reserves right to use in own programs.                       }
  12. {________________________________________________}
  13. UNIT PaintFileMgr;
  14.  
  15. INTERFACE
  16.  
  17.     PROCEDURE GetPaintImage (VAR ImagePtr : Ptr);
  18.     PROCEDURE DisplayPaintFile (ImagePtr : Ptr);
  19.  
  20. IMPLEMENTATION
  21.  
  22. {--------- Internal routines --------}
  23.  
  24.     PROCEDURE doMessage (mes0 : str255;
  25.                                     mes1 : str255;
  26.                                     mes2 : str255;
  27.                                     mes3 : str255);
  28.         CONST
  29.             MessageDialog = 258;
  30.         VAR
  31.             dialogP : DialogPtr;
  32.             item : integer;
  33.             dlogRect : rect;
  34.     BEGIN
  35.         ParamText(mes0, mes1, mes2, mes3);
  36.         SetRect(dlogRect, 100, 100, 400, 200);
  37.         dialogP := GetNewDialog(MessageDialog, NIL, pointer(-1));
  38.         IF dialogP = NIL THEN
  39.             BEGIN
  40.                 SysBeep(5);
  41.                 ExitToShell;
  42.             END;
  43.         initCursor;
  44.         ModalDialog(NIL, item);
  45.         DisposDialog(dialogP);
  46.     END;
  47.  
  48.     PROCEDURE SFGetPaint (VAR theReply : SFReply);
  49.         CONST
  50.             SFPutLeft = 100;
  51.             SFPutTop = 100;
  52.         VAR
  53.             SFPutPt : Point;
  54.             PNTG_list : SFTypeList;
  55.     BEGIN
  56.         PNTG_list[0] := 'PNTG';
  57.         SetPt(SFPutPt, SFPutLeft, SFPutTop);
  58.         SFGetFile(SFPutPt, '', NIL, 1, PNTG_list, NIL, theReply);
  59.     END;{SFGetPaint}
  60.  
  61.     PROCEDURE CloseOldFile (refNum : Integer;
  62.                                     vRefNum : Integer);
  63.         VAR
  64.             err : OSErr;
  65.     BEGIN
  66.         err := FSClose(refNum);
  67.         IF err <> noErr THEN
  68.             BEGIN
  69.                 doMessage('FSClose error', 'CloseOldFile routine', 'Could not close file ', '');
  70.             END;
  71.         err := FlushVol(NIL, vRefNum);
  72.         IF err <> noErr THEN
  73.             BEGIN
  74.                 doMessage('FlushVol error', 'CloseOldFile routine', 'Could not Flush volume ', '');
  75.             END;
  76.     END;{CloseOldFile}
  77.  
  78.     PROCEDURE ReadPaintFile (refNum : Integer;
  79.                                     VAR PackedBitsPtr : Ptr);
  80.         LABEL
  81.             1;
  82.         VAR
  83.             bytes : LongInt;
  84.             str1 : str255;
  85.             err : OSErr;
  86.     BEGIN
  87.         PackedBitsPtr := NIL;
  88.         err := GetEOF(refNum, bytes);  {FIND LOGICAL END OF FILE}
  89.         IF err <> noErr THEN
  90.             BEGIN
  91.                 doMessage('GetEOF error', 'ReadPaintFile routine', 'Could not find file end', '');
  92.             END;
  93.         bytes := bytes - 512;            {HEADER BLOCK NOT NEEDED}
  94.         IF odd(bytes) THEN
  95.             BEGIN
  96.                 NumToString(bytes, str1);
  97.                 str1 := concat('Bytes - header = ', str1);
  98.                 doMessage('Logical EOF Odd', str1, 'Not a MacPaint File.', '');
  99.         {goto 1;  try anyway!}
  100.             END
  101.         ELSE
  102.             BEGIN
  103.                 NumToString(bytes, str1);
  104.                 str1 := concat('Bytes - header =', str1);
  105.                 doMessage('Reading Paint type...', str1, '', '');
  106.             END;
  107.         PackedBitsPtr := NewPtr(bytes);    {MAKE A HOME FOR THE DATA}
  108.         IF MemError <> noErr THEN
  109.             BEGIN
  110.                 PackedBitsPtr := NIL;
  111.                 doMessage('PackBitsPtr Memory err', 'ReadPaintFile routine', 'No room to read in data', '');
  112.                 GOTO 1;
  113.             END;
  114.         err := SetFPos(refNum, FSFromStart, 512);     {START AT BEGINNING OF DATA}
  115.         IF err <> noErr THEN
  116.             BEGIN
  117.                 doMessage('SetFPos error', 'ReadPaintFile routine', 'Could not set file ', 'at start of data');
  118.             END;
  119.         err := FSRead(refNum, bytes, PackedBitsPtr);  {READ THE DATA TO THE BUFFER}
  120.         IF err <> noErr THEN
  121.             BEGIN
  122.                 doMessage('FSRead error', 'ReadPaintFile routine', 'Problem reading in file', '');
  123.                 GOTO 1;
  124.             END;
  125. 1 :
  126.     END;{ReadPaintFile}
  127.  
  128.     PROCEDURE GetPaintImage;{ (var ImagePtr : Ptr)}
  129.         LABEL
  130.             2;
  131.         CONST
  132.             SizeOfPaintImage = 51840;
  133.         VAR
  134.             refNum : Integer;
  135.             theReply : SFReply;
  136.             err : OSErr;
  137.             packedBitsPtr : Ptr;
  138.             destPtr, SrcPtr : Ptr;
  139.             saveStart : longInt;
  140.             bytesUnPacked : Integer;
  141.     BEGIN
  142.         ImagePtr := NIL;
  143.         SFGetPaint(theReply);
  144.         WITH theReply DO
  145.             IF NOT good THEN
  146.                 GOTO 2
  147.             ELSE
  148.                 BEGIN
  149.                     err := FSOpen(fName, vRefNum, refNum);
  150.                     IF err <> 0 THEN
  151.                         BEGIN
  152.                             doMessage('FSOpen error on file', 'GetPaintImage routine', 'Can not Open File ', '');
  153.                             GOTO 2;
  154.                         END;
  155.                     ReadPaintFile(refNum, packedBitsPtr);
  156.             {RETURNS A POINTER TO THE PACKED DATA.  SEE ABOVE}
  157.                     CloseOldFile(refNum, vRefNum);     {CLOSE FILE IMMEDIATELY}
  158.                     IF packedBitsPtr = NIL THEN
  159.                         BEGIN
  160.                             GOTO 2;
  161.                         END;
  162.                     ImagePtr := NewPtr(SizeOfPaintImage); {MAKE A HOME FOR THE IMAGE}
  163.                     IF MemError <> 0 THEN
  164.                         BEGIN
  165.                             doMessage('ImagePtr Memory err', 'GetPaintImage routine', 'No room for image', '');
  166.                             GOTO 2;
  167.                         END;
  168.  
  169.                 {POINTERS TO BE USED BY UNPACKBITS WILL BE INCREMENTED, SO SAVE}
  170.                 {OLD POINTERS BY CREATING A COUPLE OF SCAPEGOATS:SRCPTR AND DESTPTR}
  171.                     SrcPtr := packedBitsPtr;    {SRCPTR WILL BE INCREMENTED}
  172.                     DestPtr := ImagePtr;    {DESTPTR WILL BE INCREMENTED}
  173.  
  174.                 {A PAINT IMAGE HAS MORE BYTES THAN CAN BE REPRESENTED BY AN}
  175.                 {INTEGER, AND UNPACKBITS ACCEPTS ONLY INTEGERS, SO UNPACK}
  176.                 {ONLY HALF THE BYTES AT A TIME.}
  177.  
  178.                     saveStart := ord(DestPtr);
  179.                     UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage DIV 2);
  180.                     bytesUnPacked := ord(DestPtr) - saveStart;
  181.  
  182.                 {THE FINAL UNPACKING STARTS FROM THE NEW VALUES OF SRCPTR.}
  183.                     UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage - bytesUnPacked);
  184.                     DisposPtr(packedBitsPtr);
  185.                 END;
  186. 2 :
  187.     END;{GetPaintImage}
  188.  
  189.     PROCEDURE DisplayPaintFile; {(ImagePtr : Ptr);}
  190.         LABEL
  191.             3;
  192.         VAR
  193.             pageBits : BitMap;
  194.             drawRect : Rect;
  195.             screen : Rect;
  196.     BEGIN
  197.         IF ImagePtr = NIL THEN
  198.             BEGIN
  199.                 GOTO 3;
  200.             END;
  201.  
  202.         {SET UP AN APPROPRIATE BITMAP TO SEND TO COPYBITS}
  203.         WITH pageBits DO
  204.             BEGIN
  205.                 baseAddr := ImagePtr;     {GIVE THE BUFFER TO THE BITMAP}
  206.                 rowBytes := 72;            {ROWBYTES OF PAINT IMAGE}
  207.                 SetRect(bounds, 0, 0, 576, 720);     {ENCLOSES PAINT IMAGE}
  208.             END;
  209.  
  210.         {ASSUMES THE MAIN PROGRAM HAS OPENED A WINDOW APPROX}
  211.         {THE SAME SIZE AS THE SCREEN AND SET THE PORT}
  212.         screen := screenBits.bounds;
  213.         setRect(drawRect, screen.left + 148, screen.top + 0, screen.right - 148, screen.bottom - 72); {3/8 image bounds size}
  214.         copyBits(pageBits, thePort^.portbits, pagebits.bounds, drawRect, srcCopy, NIL);
  215. 3 :
  216.     END;{DisplayPaintFile}
  217.  
  218. END.    {of unit}